home *** CD-ROM | disk | FTP | other *** search
/ Programming Languages Suite / ProgramD2.iso / Visual Database / Visual Foxpro 6.0 (Ent. Edition) / Vf6ent Extractor.EXE / TOOLS / XSOURCE / XSOURCE.ZIP / vfpsource / wizards / Wzfoxdoc / analyzer.prg < prev    next >
Encoding:
Text File  |  1998-05-01  |  8.6 KB  |  422 lines
  1. #define MAXDEPTH 50
  2. #define    SPECIFYDIR_LOC      "You must supply the name of the Documenting Wizard target directory."
  3. #define ACTIVATEWIN_LOC     "You must activate an edit window first."
  4. #define GETDIRPROMPT_LOC "Doc Wizard Output Folder?"
  5.  
  6. para m1,m2
  7. set exact off
  8. set conf on
  9.  
  10. PUBLIC mdir
  11. if type("m1") = 'C'
  12.     mdir=m.m1
  13. ELSE
  14.     mdir=GETDIR(sys(2003)+"out",GETDIRPROMPT_LOC)
  15. ENDIF
  16. IF EMPTY(m.mdir) OR !FILE(mdir+"fdxref.dbf") OR !FILE(mdir+"files.dbf")
  17.     MESSAGEBOX(SPECIFYDIR_LOC,16)
  18.     RETURN .f.
  19. ENDIF
  20. IF USED("fdxref")
  21.     SELECT fdxref
  22. ELSE
  23.     USE (mdir+"fdxref") EXCLUSIVE
  24. ENDIF
  25. IF !ISEXCL()
  26.     USE (DBF()) EXCLUSIVE
  27. ENDIF
  28. set order to symbol
  29. IF !USED("symbols")
  30.     SELECT upper(symbol) as symbol,count(*) as count ;
  31.         FROM fdxref INTO CURSOR symbols order by 1 group by 1
  32. ENDIF
  33. SELECT symbols
  34. LOCATE
  35.  
  36. do form jump
  37. PROC tex
  38.     para mm && Definition Reference Next Back Goto
  39.     publ mwinname,mwinpos,seekmode,m.symbol
  40.     SELECT fdxref
  41.     set order to symbol
  42.     seekmode=m.mm
  43.     do setlibr
  44.     if m.seekmode='G'
  45.         IF EMPTY(filename)
  46.             RETURN
  47.         ENDIF
  48.         IF RIGHT(UPPER(ALLTRIM(filename)),4)$".VCX.SCX.DBC"
  49.             IF USED("snipfile")
  50.                 USE IN snipfile
  51.             ENDIF
  52.             USE (ALLTRIM(fdxref.filename)) AGAIN IN 0 ALIAS snipfile
  53.             GO (fdxref.sniprecno) IN snipfile
  54.             IF !EMPTY(fdxref.snipfld)
  55.                 MODI MEMO ("snipfile."+fdxref.snipfld) nowait noedit
  56.                 Gotorec()
  57.             ENDIF
  58.         ELSE
  59.             modi comm (filename) nowait noedit
  60.             Gotorec()
  61.         ENDIF
  62.         SET LIBR TO
  63.         return
  64.     endif
  65.     IF type("fdstack[1]")='U'
  66.         PUBLIC fdstack[1,1],FDSP
  67.         fdsp=0
  68.     ENDIF
  69.     IF m.seekmode='B'
  70.         IF m.fdsp>0
  71.             mwinname=fdstack[fdsp,1]
  72.             mwinpos=fdstack[fdsp,2]
  73.             =CurPos("S")
  74.             fdsp=m.fdsp-1
  75.             IF m.fdsp>0
  76.                 DIMENSION fdstack[fdsp,2]
  77.             ENDIF
  78.         ELSE
  79.         ENDIF
  80.         set libr to
  81.         RETURN
  82.     ENDIF
  83.     IF m.seekmode$"DR"
  84.         IF TYPE("_screen.activeform.caption")#'C'
  85.             =CurPos("G")
  86.         ELSE
  87.             =MessageBox(ACTIVATEWIN_LOC,16)
  88.             RETURN
  89.         ENDIF
  90.     ENDIF
  91.     *    show wind fdxref refresh
  92.     if m.seekmode$"DR"
  93.         =examine(seekmode)    &&see what's under cursor
  94.     endif
  95.     do exam    &&get cursor word into m.symbol
  96.     set libr to
  97. RETURN
  98.  
  99. PROC exam
  100.     *called by examine()... m.symbol ="" if not found
  101.     PRIVATE str
  102.     SELECT fdxref
  103.     if m.seekmode='T'
  104.         set orde to
  105.         skip
  106.         IF eof()
  107.             GO BOTT
  108.         ENDIF
  109.     else
  110.         if empty(set("order"))
  111.             SET ORDER TO symbol
  112.         ENDIF
  113.         str=PADR(UPPER(m.symbol),LEN(symbol))
  114.         IF m.seekmode$"DR"
  115.             SEEK str+m.seekmode
  116.             IF m.seekmode='D' AND !FOUND()
  117.                 SEEK str+'V'
  118.             ENDIF
  119.             IF m.seekmode='R' AND !FOUND()
  120.                 SEEK str
  121.             ENDIF
  122.         ELSE
  123.             IF !EOF()
  124.                 SKIP
  125.             ENDIF
  126.         ENDIF
  127.     ENDIF
  128.     IF m.seekmode#'T' and (EMPTY(m.symbol) OR UPPER(symbol)#UPPER(m.symbol) OR EOF())
  129.         WAIT WINDOW NOWAIT m.seekmode+' '+m.symbol+" not found"
  130.         m.symbol=""
  131.     ELSE
  132.         IF RIGHT(UPPER(ALLTRIM(filename)),4)$".VCX.SCX.DBC"
  133.             IF USED("snipfile")
  134.                 USE IN snipfile
  135.             ENDIF
  136.             USE (ALLTRIM(fdxref.filename)) AGAIN IN 0 ALIAS snipfile
  137.             GO (fdxref.sniprecno) IN snipfile
  138.             IF !EMPTY(fdxref.snipfld)
  139.                 MODI MEMO ("snipfile."+fdxref.snipfld) nowait noedit
  140.             ENDIF
  141.         ELSE
  142.             modi comm (filename) nowait noedit
  143.         ENDIF
  144.  
  145.         IF RIGHT(TRIM(filename),3)$"PRG MPR SPR"
  146.             SCATTER MEMVAR
  147.             m.lineno=INT(m.lineno)
  148.             if m.seekmode$"DR"
  149.                 fdsp=m.fdsp+1
  150.                 DIMENSION fdstack[fdsp,2]
  151.                 fdstack[fdsp,1]=mwinname
  152.                 fdstack[fdsp,2]=mwinpos
  153.             ENDIF
  154.         ELSE
  155.             m.symbol=""
  156.         ENDIF
  157.         =Gotorec()
  158.         WAIT WINDOW NOWAIT ALLTRIM(m.symbol)+" "+flag+" found in "+ALLTRIM(fdxref.Filename)+' '+STR(lineno,5) &&+" SP="+str(fdsp,2)  &&&&showsp
  159.     ENDIF
  160. RETURN
  161.  
  162.  
  163. proc setlibr
  164.         set libr to (IIF(file("fd3fll\fd3.fll"),;
  165.                 "fd3fll\fd3.fll",;
  166.                 LOCFILE(sys(2004)+"wizards\fd3.fll")))
  167.         IF "fd3"$SET("LIBR")
  168.             RETURN .T.
  169.         ENDIF
  170. return .f.
  171.  
  172. proc tre
  173.     PARAMETER nmode,ol
  174.     PRIVATE lvl,cnt,err,i
  175.     ol.style=5
  176.     ol.clear
  177.     IF !USED("files")
  178.         use (mdir+"files") EXCL in 0
  179.     ENDIF
  180.     select files
  181.     IF !ISEXCL()
  182.         USE (DBF()) EXCL ALIAS files
  183.     ENDIF
  184.     go 1
  185.     mtop=JustStem(file)
  186.     select fdxref
  187.     lvl=0
  188.     m.cnt=0
  189.     m.err=.f.
  190.     mvar1="procname"
  191.     mvar2="symbol"
  192.     m.allowdup=.t.
  193.     set talk off
  194.     ol.visible=.f.    &&debug
  195.     
  196.     DO CASE
  197.     CASE nMode=1    &&calling tree
  198.         do treediag
  199.     CASE nMode=3    &&Class Hierarchy
  200.         ON ERROR m.err=.t.
  201.         SET ORDER TO classes
  202.         IF m.err
  203.             index on upper(procname) for flag$"BC" tag classes
  204.         ENDIF
  205.         ON ERROR
  206.         SELECT DISTINCT procname FROM fdxref;
  207.             WHERE flag$"BC";
  208.             ORDER BY 1;
  209.             INTO CURSOR obj
  210.         SCAN
  211.             myrec=recno()
  212.             MTOP=UPPER(ALLTRIM(Procname))
  213.             SELECT fdxref
  214.             DO showit WITH mtop
  215.             SELECT obj
  216.             go myrec
  217.         ENDSCAN
  218.         USE IN obj
  219.         SELECT fdxref
  220.     CASE nMode=2 && Derived class hierarchy
  221.         do classdiag
  222.     ENDCASE
  223.     
  224.     FOR i=0 TO ol.listcount-1
  225.         IF ol.hassubitems[i]
  226.             ol.picturetype[i]=0
  227.         ELSE
  228.             ol.picturetype[i]=2
  229.         ENDIF
  230.     ENDFOR
  231.     ol.visible=.t.
  232. RETURN
  233.  
  234.  
  235. PROCEDURE JustStem
  236.     PARAMETERS mfile
  237.     IF AT('\',m.mfile)>0
  238.         mfile=SUBSTR(m.mfile,RAT('\',m.mfile)+1)
  239.     ENDIF && AT('/',m.mfile)>0
  240.     IF AT(".",m.mfile)>0
  241.         mfile=LEFT(m.mfile,AT(".",m.mfile)-1)
  242.     ENDIF && AT(".",m.mfile)>0
  243. RETURN m.mfile
  244. *EOP JustStem
  245.  
  246. PROC ClassDiag
  247.     LOCAL mr
  248.     PRIVATE lvl,cCollate
  249.     cCollate=SET("collate")
  250.     SET COLLATE TO "machine"
  251.     SELECT symbol,procname,flag,filename,' ' AS done;
  252.         FROM  fdxref ;
  253.         WHERE flag$"CB" AND;
  254.             UPPER(symbol) # UPPER(procname);
  255.         INTO CURSOR classd1
  256.     USE DBF("classd1") EXCL AGAIN IN 0 ALIAS classd
  257.     SELECT classd
  258.     USE IN classd1
  259.     INDEX ON done+flag+UPPER(procname) TAG dprocname
  260.     INDEX ON UPPER(procname) TAG procname
  261.     INDEX ON UPPER(symbol)  TAG symbol
  262.     m.lvl=0
  263.     m.cnt=0
  264.     DO WHILE SEEK(' ',"classd","dprocname")
  265.         mr=RECNO()
  266.         DO WHILE SEEK(UPPER(procname)),"classd","symbol")
  267.             mr=RECNO()
  268.         ENDDO
  269.         GO mr
  270.         m.lvl=1
  271.         ol.additem(ALLTRIM(procname))
  272.         ol.indent[m.cnt]=m.lvl
  273.         m.cnt=m.cnt+1
  274.         DO showclas WITH UPPER(ALLTRIM(procname))
  275.         SET ORDER TO symbol
  276.     ENDDO
  277.     USE IN classd
  278.     SET COLLATE TO (m.cCollate)
  279. RETURN
  280.     
  281. PROC showclas
  282.     PARA m.procname
  283.     LOCAL mr
  284.     m.lvl=m.lvl+1
  285.     IF SEEK(' C'+m.procname+' ',"classd","dprocname")
  286.         SET ORDER TO procname
  287.         SCAN WHILE UPPER(ALLTRIM(procname))+' ' = m.procname+' '
  288.             REPLACE done WITH 'Y'
  289.             IF m.lvl>1
  290.                 mr=recno()
  291.                 mparent=UPPER(procname)
  292.                 SKIP
  293.                 GO m.mr
  294.             ENDIF
  295.             ol.additem(ALLTRIM(symbol))
  296.             ol.indent[m.cnt]=m.lvl
  297.             m.cnt=m.cnt+1
  298.  
  299.             mr=recno()
  300.             DO showclas WITH UPPER(ALLTRIM(symbol))
  301.             GO m.mr
  302.             SET ORDER TO procname
  303.         ENDSCAN
  304.     ENDIF
  305.     m.lvl=m.lvl-1
  306. RETURN
  307.  
  308.  
  309. proc treediag
  310.     PRIVATE lvl,cnt,err
  311.     PRIVATE aLev
  312.     PRIVATE mindent,mparent
  313.     PRIVATE cActionChars
  314.     PRIVATE track
  315.     PRIVATE mtop
  316.     local msetexact,mr
  317.     DIMENSION track[MAXDEPTH]
  318.     track=""
  319.     msetexact=set("exact")
  320.     set exact on
  321.     CREATE CURSOR did (proc c(len(fdxref.symbol)))
  322.     INDEX ON upper(proc) TAG proc
  323.     select files
  324.     LOCA
  325.     IF EOF()
  326.         RETURN .f.
  327.     ENDIF
  328.     m.cnt=0
  329.     go 1
  330.     mtop=PADR(JustStem(file),LEN(fdxref.procname))    &&bugbug
  331.     select fdxref
  332.     lvl=1
  333.     m.cnt=1
  334.     m.err=.t.
  335.     DO WHILE !EMPTY(TAG(m.cnt))
  336.         IF tag(m.cnt)="PROCEDURE"
  337.             m.err=.f.
  338.             EXIT
  339.         ENDIF
  340.         m.cnt=m.cnt+1
  341.     ENDDO
  342.     IF m.err
  343.         index on upper(procname) for flag$'DF' tag procedure
  344.     ELSE
  345.         SET ORDER TO procedure
  346.     ENDIF
  347.     m.cnt=0
  348.     track=""
  349.     ol.additem(ALLTRIM(m.mtop))
  350.     ol.indent[m.cnt]=m.lvl
  351.     m.cnt=m.cnt+1
  352.     DO showit WITH mtop
  353.     *now find all missing subtrees
  354.     SELECT fdxref
  355.     SCAN for flag='D'
  356.         MR=recno()
  357.         *find top of subtree
  358.         m.mtop=fdxref.symbol
  359.         DO WHILE SEEK(UPPER(m.mtop)+'F',"fdxref","symbol") AND !"."$fdxref.procname AND ;
  360.                 UPPER(ALLTRIM(fdxref.symbol)) # UPPER(ALLTRIM(fdxref.procname))
  361.             m.mtop=PADR(fdxref.procname,LEN(fdxref.symbol))
  362.         ENDDO
  363.         m.mtop=PADR(m.mtop,len(fdxref.procname))
  364.         IF !SEEK(UPPER(m.mtop),"did")
  365.             m.lvl=1    
  366.             ol.additem(ALLTRIM(m.mtop))
  367.             ol.indent[m.cnt]=m.lvl
  368.             m.cnt=m.cnt+1
  369.             DO showit WITH PADR(fdxref.symbol,LEN(fdxref.procname))
  370.         ENDIF
  371.         GO m.MR
  372.     ENDSCAN
  373.     USE IN did
  374.     SET ORDER TO
  375.     set exact &msetexact
  376. RETURN
  377.  
  378.  
  379.  
  380. PROC showit
  381.     Para prg
  382.     priv mr,i
  383.     INSERT INTO did VALUES (UPPER(m.prg))
  384.     seek UPPER(m.prg)
  385.     IF !FOUND() OR m.lvl>=MAXDEPTH
  386.         RETURN
  387.     ENDIF
  388.     lvl=m.lvl+1
  389.     scan while upper(procname) = UPPER(m.prg)
  390.         if flag #'D'
  391.  
  392.             IF m.lvl>1
  393.                 mr=recno()
  394.                 mparent=UPPER(procname)
  395.                 SKIP
  396.                 GO m.mr
  397.             ENDIF
  398.             ol.additem(ALLTRIM(symbol))
  399.             ol.indent[m.cnt]=m.lvl
  400.             m.cnt=m.cnt+1
  401.             I = ASCAN(track,UPPER(TRIM(symbol)))
  402.             IF m.i>0
  403.                 ol.additem("Recursion")
  404.                 ol.indent[m.cnt]=m.lvl
  405.                 m.cnt=m.cnt+1
  406.             ELSE
  407.                 mr=recno()
  408.                 track[m.lvl]=UPPER(trim(symbol))
  409.                 do showit with PADR(symbol,LEN(fdxref.procname))
  410.                 track[m.lvl]=""
  411.                 go mr
  412.             ENDIF
  413.         endif
  414.     ENDsc
  415.     lvl=m.lvl-1
  416. RETURN
  417.  
  418.  
  419. proc gotorec
  420. proc curpos
  421. proc examine
  422.